home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu358.dms / pu358.adf / DonsGenies / Don'sGenies / MakeBarChart_Horz.pprx < prev    next >
Text File  |  1992-07-16  |  4KB  |  176 lines
  1. /*@BMakeBarChart_Horz @P@ICopyright Michael S. Fahrion. January, 1992
  2. Makes a simple horizontal bar chart from data entered by the user.
  3. (This version debugged/enhanced by Don Cox.)
  4. */
  5. numeric digits 8
  6. cr = '0a'x
  7. call SafeEndEdit.rexx()
  8. call ppm_AutoUpdate(0)
  9. call ppm_NewGroup()
  10.  
  11. units = ppm_GetUnits()
  12. call ppm_SetUnits(1)
  13.  
  14. signal on halt
  15. signal on break_c
  16. signal on break_e
  17. signal on break_d
  18.  
  19. box = ppm_ClickOnBox("Click on box to make chart..")
  20.  
  21. if box = 0 then
  22. do
  23.     call ppm_Inform(1, "No box selected",)
  24.     call ppm_ClearStatus()
  25.     exit
  26. end
  27.  
  28. /*  extract box attributes  */
  29. boxsize = ppm_GetBoxSize(box)
  30. boxpos = ppm_GetBoxPosition(box)
  31.  
  32. if ppm_Inform(2, "Delete box?",) = 1 then call ppm_DeleteBox(box)
  33.  
  34. boxwidth = word(boxsize, 1)
  35. boxheight = word(boxsize, 2)
  36. boxleft = word(boxpos, 1)
  37. boxtop = word(boxpos, 2)
  38. /* trace(results) */
  39.  
  40. nmbars = GetUserText(4, "Number of Bars")
  41. if nmbars > 12 then exit_msg("Max number of bars is 12")
  42.  
  43. form = ' Bar 1'
  44. do x = 2 while x <= nmbars
  45.  form = form cr 'Bar' x
  46. end
  47. form = form cr 'Top scale #'
  48.  
  49. form = ppm_GetForm("Chart Data",6,form)
  50. if form = "" then exit_msg("Operation Cancelled")
  51.  
  52. x = 1
  53. do forever
  54.   parse var form bdata.x '0a'x form
  55.   if bdata.x = "" then leave
  56.   x = x + 1
  57. end
  58. tchart = nmbars + 1
  59. topchart = bdata.tchart
  60.  
  61. form = ' Bar label 1'
  62. do x = 2 while x <= nmbars
  63.    form = form cr 'Bar label' x
  64. end
  65.  
  66. form = ppm_GetForm("Chart Label",8,form)
  67. if form = "" then exit_msg("Operation Cancelled")
  68.  
  69. x = 1
  70. do forever
  71.    parse var form blabel.x '0a'x form
  72.    if blabel.x = "" then leave
  73.    x = x + 1
  74. end
  75.  
  76. facelist = ppm_GetTypeFaceList()
  77. facelist = substr(facelist, pos('0a'x, facelist) +1) /*strip off the number*/
  78. face = ppm_SelectFromList("Select Typeface",32,18,0,facelist)
  79.  
  80. /* Draw background chart and grid lines */
  81.  
  82. barbottom = boxtop + boxheight
  83.  
  84. call ppm_ShowStatus("Creating Chart Grid")
  85. linespace = boxwidth / 10
  86. gridline = linespace + boxleft
  87.  
  88. call ppm_SetLineWeight(.5)
  89. do 9
  90.   call ppm_DrawLine(gridline, boxtop, gridline, boxtop + boxheight)
  91.   gridline = gridline + linespace
  92.   call ppm_AddToGroup()
  93. end
  94.  
  95. call ppm_SetLineWeight(1)
  96. call ppm_SetFillPattern(0)
  97. call ppm_DrawRect(boxleft, boxtop, boxleft + boxwidth, boxtop + boxheight)
  98. call ppm_AddToGroup()
  99.  
  100. call ppm_MergeGroup()
  101.  
  102. /* add chart numbers */
  103.  
  104. call ppm_ShowStatus("Adding chart scale")
  105. call ppm_SetFont(face)
  106. call ppm_SetSize(10)
  107. call ppm_SetStyle(N)
  108. call ppm_SetJustification(2)
  109.  
  110. bleft = (boxleft + boxwidth - .25) 
  111. btop = boxtop + boxheight + .05
  112. ctext = topchart
  113. ctextadjust = topchart / 10
  114. i = 1
  115.  
  116. do 11
  117.   cbox = ppm_CreateBox(bleft, btop, .5, .25, 0)
  118.   bleft = bleft - linespace
  119.   call ppm_TextIntoBox(cbox, ctext)
  120.   ctext = topchart - (ctextadjust * i)
  121.   i = i + 1
  122. end
  123.  
  124. /* Draw chart bars */
  125.  
  126. barcalc = boxwidth / topchart
  127. barspace = (nmbars + 1) * .125
  128. barwidth = (boxheight - barspace) / nmbars
  129. barpos = boxtop + .125
  130. call ppm_SetFillPattern(5)
  131.  
  132. i = 1
  133.  
  134. do nmbars
  135.   call ppm_ShowStatus("Working on bar:" i)
  136.   barlength = bdata.i * barcalc
  137.   barlength = boxleft + barlength
  138.   call ppm_DrawRect(boxleft, barpos, barlength, barpos + barwidth)
  139.   
  140.   call ppm_SetJustification(1)
  141.   cbox = ppm_CreateBox(boxleft - .53, barpos, .5, .25, 0)
  142.   call ppm_TextIntoBox(cbox, upper(blabel.i))
  143.   call ppm_SetJustification(0)
  144.   cbox = ppm_CreateBox(barlength + .05, barpos, .3, .15, 0)
  145.   call ppm_SetBoxTransparent(cbox,0)
  146.   call ppm_TextIntoBox(cbox, bdata.i)
  147.   barpos = barpos + barwidth + .125
  148.   i = i + 1
  149. end
  150.  
  151. exit_msg("Done")
  152. break_d:
  153. break_e:
  154. break_c:
  155. halt:
  156.     call exit_msg("User aborted Genie!")
  157.  
  158. exit_msg: procedure expose units
  159. do
  160.    parse arg message
  161.  
  162.     call ppm_ClearStatus()
  163.  
  164.    if message ~= '' then
  165.        call ppm_Inform(1, message,)
  166.  
  167.    call ppm_SetUnits(units)
  168.    call ppm_ClearStatus()
  169.    call ppm_AutoUpdate(1)
  170.    exit
  171. end
  172.  
  173.  
  174.  
  175.  
  176.